home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 06 - 1990 / 06.09 Sep 90 / LSObjectShell / MyDocuments.p < prev    next >
Encoding:
Text File  |  1989-10-15  |  17.9 KB  |  808 lines  |  [TEXT/PJMM]
  1. UNIT MyDocuments;
  2. {***********************************}
  3. INTERFACE
  4.  
  5.     USES
  6.         MemTypes, QuickDraw, OSIntf, ToolIntf, PackIntf, MacPrint, ObjIntf, GlobalStuff, MyDialogs, MyShapes;
  7.  
  8.     TYPE
  9.         TDocument = OBJECT(TObject)
  10.                 fDocType: OSType;
  11.                 fVolNum: Integer;
  12.                 fFileNum: Integer;
  13.                 fChanged: BOOLEAN;
  14.                 fViewRgn: RgnHandle;
  15.                 fViewRect: Rect;
  16.                 fDocRect: Rect;
  17.                 fTextHdl: TEHandle;
  18.                 fPictHdl: PicHandle;
  19.                 fMyHdl: Handle;
  20.                 fForeC: Integer;
  21.                 fBackC: Integer;
  22.                 fShapeID: Integer;
  23.                 PROCEDURE DoNew;
  24.                 PROCEDURE DoOpen (vVolNum, vFileNum: Integer);
  25.                 PROCEDURE DoSave (vFileNum: Integer);
  26.                 PROCEDURE DoPrint (vPrPort: TPPrPort);
  27.                 PROCEDURE ApplTask;
  28.                 PROCEDURE ClickInDoc (vPt: Point);
  29.                 PROCEDURE KeyPress (vChar: CHAR);
  30.                 PROCEDURE ReDraw;
  31.                 PROCEDURE Update;
  32.                 PROCEDURE Activate;
  33.                 PROCEDURE Edit (vItem: Integer);
  34.             END;
  35.  
  36.         TTextDocument = OBJECT(TDocument)
  37.                 PROCEDURE DoNew;
  38.                 override;
  39.                 PROCEDURE DoOpen (vVolNum, vFileNum: Integer);
  40.                 override;
  41.                 PROCEDURE DoSave (vFileNum: Integer);
  42.                 override;
  43.                 PROCEDURE DoPrint (vPrPort: TPPrPort);
  44.                 override;
  45.                 PROCEDURE ApplTask;
  46.                 override;
  47.                 PROCEDURE ClickInDoc (vPt: Point);
  48.                 override;
  49.                 PROCEDURE KeyPress (vChar: CHAR);
  50.                 override;
  51.                 PROCEDURE ReDraw;
  52.                 override;
  53.                 PROCEDURE Update;
  54.                 override;
  55.                 PROCEDURE Activate;
  56.                 override;
  57.                 PROCEDURE Edit (vItem: Integer);
  58.                 override;
  59.                 PROCEDURE Free;
  60.                 override;
  61.             END;
  62.  
  63.         TPictDocument = OBJECT(TDocument)
  64.                 oOvals: TOvals;
  65.                 oSpirals: TSpirals;
  66.                 oShape: TShape;
  67.                 PROCEDURE DoNew;
  68.                 override;
  69.                 PROCEDURE DoOpen (vVolNum, vFileNum: Integer);
  70.                 override;
  71.                 PROCEDURE DoSave (vFileNum: Integer);
  72.                 override;
  73.                 PROCEDURE DoPrint (vPrPort: TPPrPort);
  74.                 override;
  75.                 PROCEDURE ApplTask;
  76.                 override;
  77.                 PROCEDURE ClickInDoc (vPt: Point);
  78.                 override;
  79.                 PROCEDURE ReDraw;
  80.                 override;
  81.                 PROCEDURE Update;
  82.                 override;
  83.                 PROCEDURE Edit (vItem: Integer);
  84.                 override;
  85.                 PROCEDURE Free;
  86.                 override;
  87.             END;
  88.  
  89. {***********************************}
  90. IMPLEMENTATION
  91.  
  92.     FUNCTION SetColor (vColor: Integer): LongInt;
  93.     BEGIN
  94.         CASE vColor OF
  95.             kBlack: 
  96.                 SetColor := blackColor;
  97.             kWhite: 
  98.                 SetColor := whiteColor;
  99.             kRed: 
  100.                 SetColor := redColor;
  101.             kGreen: 
  102.                 SetColor := greenColor;
  103.             kBlue: 
  104.                 SetColor := blueColor;
  105.             kCyan: 
  106.                 SetColor := cyanColor;
  107.             kMagenta: 
  108.                 SetColor := magentaColor;
  109.             kYellow: 
  110.                 SetColor := yellowColor;
  111.         END;
  112.     END;    {SetColor}
  113.  
  114. {----------------------------------------}
  115.     PROCEDURE TDocument.DoNew;
  116.     BEGIN
  117.         fVolNum := 0;
  118.         fFileNum := 0;
  119.         fChanged := FALSE;
  120.         fTextHdl := NIL;
  121.         fPictHdl := NIL;
  122.         fMyHdl := NIL;
  123.     END; {DoNew}
  124.  
  125. {----------------------------------------}
  126.     PROCEDURE TDocument.DoOpen (vVolNum, vFileNum: Integer);
  127.     BEGIN
  128.     END; {DoOpen}
  129.  
  130. {----------------------------------------}
  131.     PROCEDURE TDocument.DoSave (vFileNum: Integer);
  132.     BEGIN
  133.     END; {DoSave}
  134.  
  135. {----------------------------------------}
  136.     PROCEDURE TDocument.DoPrint (vPrPort: TPPrPort);
  137.     BEGIN
  138.     END; {DoPrint}
  139.  
  140. {----------------------------------------}
  141.     PROCEDURE TDocument.ApplTask;
  142.     BEGIN
  143.     END; {ApplTask}
  144.  
  145. {----------------------------------------}
  146.     PROCEDURE TDocument.ClickInDoc (vPt: Point);
  147.     BEGIN
  148.     END; {ClickInDoc}
  149.  
  150. {----------------------------------------}
  151.     PROCEDURE TDocument.KeyPress (vChar: CHAR);
  152.     BEGIN
  153.     END; {KeyPress}
  154.  
  155. {----------------------------------------}
  156.     PROCEDURE TDocument.ReDraw;
  157.     BEGIN
  158.     END; {ReDraw}
  159.  
  160. {----------------------------------------}
  161.     PROCEDURE TDocument.Update;
  162.     BEGIN
  163.     END; {Update}
  164.  
  165. {----------------------------------------}
  166.     PROCEDURE TDocument.Activate;
  167.     BEGIN
  168.     END; {Activate}
  169.  
  170. {----------------------------------------}
  171.     PROCEDURE TDocument.Edit (vItem: Integer);
  172.     BEGIN
  173.     END; {Edit}
  174.  
  175. {========================================}
  176.     PROCEDURE TTextDocument.DoNew;
  177.         VAR
  178.             vColumnWidth: Integer;
  179.             vViewRect: Rect;
  180.  
  181.     BEGIN
  182.         INHERITED DoNew;
  183.         vColumnWidth := 6 * 72;
  184.         vViewRect := fViewRect;
  185.         InsetRect(vViewRect, kTextMargin, 0);
  186.         fViewRect := vViewRect;
  187.         fDocRect := fViewRect;
  188.         fDocRect.right := vColumnWidth;
  189.         fTextHdl := TENew(fDocRect, fViewRect);
  190.         fDocType := 'TEXT';
  191.         TextSize(12);
  192.         fTextHdl^^.txSize := thePort^.txSize;
  193.         TextFace([]);
  194.         fMyHdl := NewHandle($2);
  195.         fMyHdl^^ := -128;
  196.         fForeC := kBlack;
  197.         fBackC := kWhite;
  198.     END; {DoNew}
  199.  
  200. {----------------------------------------}
  201.     PROCEDURE TTextDocument.DoOpen (vVolNum, vFileNum: Integer);
  202.         VAR
  203.             vFileSize: LongInt;
  204.             vHdl: Handle;
  205.             vDocRect: Rect;
  206.  
  207.     BEGIN
  208.         IF OSError(GetEOF(vFileNum, vFileSize)) THEN
  209.             Exit(DoOpen);
  210.         IF OSError(SetFPos(vFileNum, FSFromStart, 0)) THEN
  211.             Exit(DoOpen);
  212.         IF vFileSize > MaxInt THEN
  213.             BEGIN
  214.                 CenterMyDialog('ALRT', kSizeErrID);
  215.                 IF StopAlert(kSizeErrID, NIL) = OK THEN
  216.                     Exit(DoOpen);
  217.             END;
  218.         SetHandleSize(fTextHdl^^.hText, vFileSize);
  219.         IF OSError(MemError) THEN
  220.             Exit(DoOpen);
  221.         vHdl := fTextHdl^^.hText;
  222.         MoveHHi(vHdl);
  223.         HLock(vHdl);
  224.         IF OSError(FSRead(vFileNum, vFileSize, vHdl^)) THEN
  225.             BEGIN
  226.                 HUnlock(vHdl);
  227.                 Exit(DoOpen);
  228.             END;
  229.         HUnlock(vHdl);
  230.         fTextHdl^^.teLength := vFileSize;
  231.         TECalText(fTextHdl);
  232.         TESetSelect(MaxInt, MaxInt, fTextHdl);
  233.         WITH fDocRect, fTextHdl^^ DO
  234.             BEGIN
  235.                 bottom := top + nLines * lineHeight;
  236.                 vDocRect := fDocRect;
  237.                 OffsetRect(vDocRect, 0, bottom);
  238.                 fDocRect := vDocRect;
  239.             END;
  240.         fVolNum := vVolNum;
  241.         fFileNum := vFileNum;
  242.         fChanged := FALSE;
  243.     END; {DoOpen}
  244.  
  245. {----------------------------------------}
  246.     PROCEDURE TTextDocument.DoSave (vFileNum: Integer);
  247.         VAR
  248.             vFileSize: LongInt;
  249.             vHdl: Handle;
  250.  
  251.     BEGIN
  252.         IF OSError(SetFPos(vFileNum, FSFromStart, 0)) THEN
  253.             Exit(DoSave);
  254.         vFileSize := fTextHdl^^.teLength;
  255.         vHdl := fTextHdl^^.hText;
  256.         MoveHHi(vHdl);
  257.         HLock(vHdl);
  258.         IF OSError(FSWrite(vFileNum, vFileSize, vHdl^)) THEN
  259.             BEGIN
  260.                 HUnlock(vHdl);
  261.                 Exit(DoSave);
  262.             END;
  263.         HUnlock(vHdl);
  264.         fFileNum := vFileNum;
  265.         fChanged := FALSE;
  266.     END; {DoSave}
  267.  
  268. {----------------------------------------}
  269.     PROCEDURE TTextDocument.DoPrint (vPrPort: TPPrPort);
  270.         VAR
  271.             vHMargin, vVMargin: Integer;
  272.             vPageRect: Rect;
  273.             vTextHdl: TEHandle;
  274.             vPageSize: Integer;
  275.             vPageHeight: Integer;
  276.             vDocSize: Integer;
  277.             vNumCopies: Integer;
  278.             i: Integer;
  279.  
  280.     BEGIN
  281.         WITH fTextHdl^^ DO
  282.             BEGIN
  283.                 TextFont(txFont);
  284.                 TextSize(txSize);
  285.                 TextFace(txFace);
  286.             END;
  287.         WITH gPrintHdl^^.prInfo DO
  288.             BEGIN
  289.                 vHMargin := ROUND(kPrintMargin * iHRes);
  290.                 vVMargin := ROUND(kPrintMargin * iVRes);
  291.                 vPageRect := rPage;
  292.                 InsetRect(vPageRect, vHMargin, vVMargin);
  293.             END;
  294.         vTextHdl := TENew(vPageRect, vPageRect);
  295.         WITH vTextHdl^^, viewRect DO
  296.             BEGIN
  297.                 vPageSize := (bottom - top) DIV lineHeight;
  298.                 vPageHeight := vPageSize * lineHeight;
  299.                 bottom := top + vPageHeight;
  300.                 destRect := viewRect;
  301.                 DisposHandle(hText);
  302.                 hText := fTextHdl^^.hText;
  303.                 teLength := fTextHdl^^.teLength;
  304.             END;
  305.         SetCursor(gWatch);
  306.         TECalText(vTextHdl);
  307.         SetCursor(arrow);
  308.         WITH gPrintHdl^^.prJob DO
  309.             IF bJDocLoop = BDraftLoop THEN
  310.                 vNumCopies := iCopies
  311.             ELSE
  312.                 vNumCopies := 1;
  313.         MoveHHi(Handle(vTextHdl));
  314.         HLock(Handle(vTextHdl));
  315.         WITH vTextHdl^^ DO
  316.             FOR i := 1 TO vNumCopies DO
  317.                 BEGIN
  318.                     vDocSize := nLines;
  319.                     WHILE vDocSize > 0 DO
  320.                         BEGIN
  321.                             PrOpenPage(vPrPort, NIL);
  322.                             IF OSError(PrError) THEN
  323.                                 leave;
  324.                             TEUpdate(viewRect, vTextHdl);
  325.                             OffsetRect(destRect, 0, -vPageHeight);
  326.                             PrClosePage(vPrPort);
  327.                             IF OSError(PrError) THEN
  328.                                 leave;
  329.                             vDocSize := vDocSize - vPageSize;
  330.                         END;
  331.                 END;
  332.         vTextHdl^^.hText := NIL;
  333.         HUnlock(Handle(vTextHdl));
  334.         TEDispose(vTextHdl);
  335.     END; {DoPrint}
  336.  
  337. {----------------------------------------}
  338.     PROCEDURE TTextDocument.ApplTask;
  339.         VAR
  340.             vPt: Point;
  341.             vCopyFlag: BOOLEAN;
  342.             vPasteFlag: BOOLEAN;
  343.  
  344.     BEGIN
  345.         TEIdle(fTextHdl);
  346.         GetMouse(vPt);
  347.         IF PtInRgn(vPt, fViewRgn) THEN
  348.             SetCursor(gIBeam)
  349.         ELSE
  350.             SetCursor(arrow);
  351.         WITH fTextHdl^^ DO
  352.             vCopyFlag := (selStart <> selEnd);
  353.         vPasteFlag := (TEGetScrapLen <> 0);
  354.         SetEnable(kEditID, kCut, vCopyFlag);
  355.         SetEnable(kEditID, kCopy, vCopyFlag);
  356.         SetEnable(kEditID, kPaste, vPasteFlag);
  357.     END; {ApplTask}
  358.  
  359. {----------------------------------------}
  360.     PROCEDURE TTextDocument.ClickInDoc (vPt: Point);
  361.         VAR
  362.             vShift: BOOLEAN;
  363.  
  364.     BEGIN
  365.         vShift := (BitAnd(gEvent.modifiers, ShiftKey) = ShiftKey);
  366.         TEClick(vPt, vShift, fTextHdl);
  367.     END; {ClickInDoc}
  368.  
  369. {----------------------------------------}
  370.     PROCEDURE TTextDocument.KeyPress (vChar: CHAR);
  371.     BEGIN
  372.         IF fTextHdl <> NIL THEN
  373.             BEGIN
  374.                 IF (fTextHdl^^.teLength = MaxInt) AND (vChar <> Chr(kBS)) THEN
  375.                     BEGIN
  376.                         CenterMyDialog('ALRT', kSizeErrID);
  377.                         IF StopAlert(kSizeErrID, NIL) = OK THEN
  378.                             Exit(KeyPress);
  379.                     END;
  380.                 TEKey(vChar, fTextHdl);
  381.                 WITH fDocRect, fTextHdl^^ DO
  382.                     bottom := top + lineHeight * nLines;
  383.                 fChanged := TRUE;
  384.             END;
  385.     END; {KeyPress}
  386.  
  387. {----------------------------------------}
  388.     PROCEDURE TTextDocument.ReDraw;
  389.         VAR
  390.             vFontInfo: FontInfo;
  391.             vViewRect: Rect;
  392.  
  393.     BEGIN
  394.         vViewRect := fViewRect;
  395.         InsetRect(vViewRect, kTextMargin, 0);
  396.         fViewRect := vViewRect;
  397.         ForeColor(SetColor(fForeC));
  398.         BackColor(SetColor(fBackC));
  399.         GetFontInfo(vFontInfo);
  400.         WITH fTextHdl^^, vFontInfo, fDocRect DO
  401.             BEGIN
  402.                 fontAscent := ascent;
  403.                 lineHeight := ascent + descent + leading;
  404.                 bottom := top + nLines * lineHeight;
  405.             END;
  406.         TECalText(fTextHdl);
  407.         InvalRgn(fViewRgn);
  408.     END; {ReDraw}
  409.  
  410. {----------------------------------------}
  411.     PROCEDURE TTextDocument.Update;
  412.     BEGIN
  413.         WITH fTextHdl^^ DO
  414.             BEGIN
  415.                 viewRect := fViewRect;
  416.                 destRect := fDocRect;
  417.                 TEUpdate(viewRect, fTextHdl);
  418.             END;
  419.     END; {Update}
  420.  
  421. {----------------------------------------}
  422.     PROCEDURE TTextDocument.Activate;
  423.     BEGIN
  424.         IF fTextHdl <> NIL THEN
  425.             IF BitAnd(gEvent.modifiers, activeFlag) <> 0 THEN
  426.                 TEActivate(fTextHdl)
  427.             ELSE
  428.                 TEDeActivate(fTextHdl);
  429.     END; {Activate}
  430.  
  431. {----------------------------------------}
  432.     PROCEDURE TTextDocument.Edit (vItem: Integer);
  433.         VAR
  434.             vOffset: LongInt;
  435.  
  436.     BEGIN
  437.         CASE vItem OF
  438.             kUndo: 
  439.                 ;
  440.             kCut: 
  441.                 BEGIN
  442.                     TECut(fTextHdl);
  443.                     IF OSError(ZeroScrap) THEN
  444.                         Exit(Edit);
  445.                     IF OSError(TEToScrap) THEN
  446.                         Exit(Edit);
  447.                 END;
  448.             kCopy: 
  449.                 BEGIN
  450.                     TECopy(fTextHdl);
  451.                     IF OSError(ZeroScrap) THEN
  452.                         Exit(Edit);
  453.                     IF OSError(TEToScrap) THEN
  454.                         Exit(Edit);
  455.                 END;
  456.             kPaste: 
  457.                 BEGIN
  458.                     IF GetScrap(NIL, 'TEXT', vOffset) > 0 THEN
  459.                         IF OSError(TEFromScrap) THEN
  460.                             Exit(Edit);
  461.                     IF (fTextHdl^^.teLength + TEGetScrapLen > MaxInt) THEN
  462.                         BEGIN
  463.                             CenterMyDialog('ALRT', kSizeErrID);
  464.                             IF StopAlert(kSizeErrID, NIL) = OK THEN
  465.                                 Exit(Edit);
  466.                         END;
  467.                     TEPaste(fTextHdl);
  468.                 END;
  469.             kClear: 
  470.                 TEDelete(fTextHdl);
  471.             OTHERWISE
  472.         END;
  473.         IF vItem <> kCopy THEN
  474.             fChanged := TRUE;
  475.         WITH fDocRect, fTextHdl^^ DO
  476.             bottom := top + lineHeight * nLines;
  477.     END; {Edit}
  478.  
  479. {----------------------------------------}
  480.     PROCEDURE TTextDocument.Free;
  481.     BEGIN
  482.         IF fMyHdl <> NIL THEN
  483.             DisposHandle(fMyHdl);
  484.         TEDispose(fTextHdl);
  485.         INHERITED Free;
  486.     END; {Free}
  487.  
  488. {========================================}
  489.     PROCEDURE TPictDocument.DoNew;
  490.     BEGIN
  491.         INHERITED DoNew;
  492.         oOvals := NIL;
  493.         oSpirals := NIL;
  494.         oShape := NIL;
  495.         IF gPrintHdl <> NIL THEN
  496.             fDocRect := gPrintHdl^^.prInfo.rPage
  497.         ELSE
  498.             fDocRect := thePort^.portRect;
  499.         fDocType := 'PICT';
  500.         fForeC := kBlack;
  501.         fBackC := kWhite;
  502.         fShapeID := 0;
  503.  
  504.         New(oOvals);
  505.         New(oOvals.oDialog);
  506.         oOvals.oDialog.Init(5, 1, kPopUPID1, FALSE);
  507.  
  508.         New(oSpirals);
  509.         New(oSpirals.oDialog);
  510.         oSpirals.oDialog.Init(3, 0, 0, FALSE);
  511.     END; {DoNew}
  512.  
  513. {----------------------------------------}
  514.     PROCEDURE TPictDocument.DoOpen (vVolNum, vFileNum: Integer);
  515.         VAR
  516.             vFileSize: LongInt;
  517.             vHdl: Handle;
  518.  
  519.     BEGIN
  520.         IF OSError(GetEOF(vFileNum, vFileSize)) THEN
  521.             Exit(DoOpen);
  522.         IF OSError(SetFPos(vFileNum, FSFromStart, kPictHeader)) THEN
  523.             Exit(DoOpen);
  524.         vFileSize := vFileSize - kPictHeader;
  525.         vHdl := NewHandle(vFileSize);
  526.         MoveHHi(vHdl);
  527.         HLock(vHdl);
  528.         IF OSError(FSRead(vFileNum, vFileSize, vHdl^)) THEN
  529.             BEGIN
  530.                 HUnlock(vHdl);
  531.                 DisposHandle(vHdl);
  532.                 Exit(DoOpen);
  533.             END;
  534.         HUnlock(vHdl);
  535.         fPictHdl := PicHandle(vHdl);
  536.         fDocRect := fPictHdl^^.picFrame;
  537.         fVolNum := vVolNum;
  538.         fFileNum := vFileNum;
  539.         fChanged := FALSE;
  540.     END; {DoOpen}
  541.  
  542. {----------------------------------------}
  543.     FUNCTION NewClearPtr (logicalSize: LongInt): Ptr;
  544.     INLINE
  545.         $201F,    {move.l (a7)+, d0}
  546.         $A31E,    {_NewPtr, CLEAR}
  547.         $2E88;    {move.l a0, (a7)}
  548.  
  549. {-  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -  -}
  550.     PROCEDURE TPictDocument.DoSave (vFileNum: Integer);
  551.         VAR
  552.             vFileSize: LongInt;
  553.             vClearPtr: Ptr;
  554.             vHdl: Handle;
  555.  
  556.     BEGIN
  557.         IF fPictHdl = NIL THEN
  558.             Exit(DoSave);
  559.         IF OSError(SetFPos(vFileNum, FSFromStart, 0)) THEN
  560.             Exit(DoSave);
  561.         vFileSize := kPictHeader;
  562.         vClearPtr := NewClearPtr(vFileSize);
  563.         IF OSError(FSWrite(vFileNum, vFileSize, vClearPtr)) THEN
  564.             BEGIN
  565.                 DisposPtr(vClearPtr);
  566.                 Exit(DoSave);
  567.             END;
  568.         DisposPtr(vClearPtr);
  569.         vHdl := Handle(fPictHdl);
  570.         vFileSize := GetHandleSize(vHdl);
  571.         MoveHHi(vHdl);
  572.         HLock(vHdl);
  573.         IF OSError(FSWrite(vFileNum, vFileSize, vHdl^)) THEN
  574.             BEGIN
  575.                 HUnlock(vHdl);
  576.                 Exit(DoSave);
  577.             END;
  578.         HUnlock(vHdl);
  579.         fFileNum := vFileNum;
  580.         fChanged := FALSE;
  581.     END; {DoSave}
  582.  
  583. {----------------------------------------}
  584.     PROCEDURE TPictDocument.DoPrint (vPrPort: TPPrPort);
  585.         VAR
  586.             vPageRect: Rect;
  587.             vDocRect: Rect;
  588.             vNumCopies: Integer;
  589.             i: Integer;
  590.  
  591.     BEGIN
  592.         WITH gPrintHdl^^.prJob DO
  593.             IF bJDocLoop = BDraftLoop THEN
  594.                 vNumCopies := iCopies
  595.             ELSE
  596.                 vNumCopies := 1;
  597.         FOR i := 1 TO vNumCopies DO
  598.             BEGIN
  599.                 PrOpenPage(vPrPort, NIL);
  600.                 IF OSError(PrError) THEN
  601.                     Exit(DoPrint);
  602.                 vDocRect := fDocRect;
  603.                 WITH fDocRect DO
  604.                     OffsetRect(vDocRect, -left, -top);
  605.                 DrawPicture(fPictHdl, vDocRect);
  606.                 PrClosePage(vPrPort);
  607.                 IF OSError(PrError) THEN
  608.             END;
  609.     END; {DoPrint}
  610.  
  611. {----------------------------------------}
  612.     PROCEDURE TPictDocument.ApplTask;
  613.         VAR
  614.             vPt: Point;
  615.             vCopyFlag: BOOLEAN;
  616.             vPasteFlag: BOOLEAN;
  617.  
  618.     BEGIN
  619.         GetMouse(vPt);
  620.         IF PtInRgn(vPt, fViewRgn) THEN
  621.             SetCursor(gCross)
  622.         ELSE
  623.             SetCursor(arrow);
  624.         vCopyFlag := TRUE;
  625.         vPasteFlag := (InfoScrap^.scrapSize > 0);
  626.         SetEnable(kEditID, kCut, vCopyFlag);
  627.         SetEnable(kEditID, kCopy, vCopyFlag);
  628.         SetEnable(kEditID, kPaste, vPasteFlag);
  629.     END; {ApplTask}
  630.  
  631. {----------------------------------------}
  632.     PROCEDURE TPictDocument.ClickInDoc (vPt: Point);
  633.     BEGIN
  634.         CASE fShapeID OF
  635.             kOvals: 
  636.                 oShape := oOvals;
  637.             kSpirals: 
  638.                 oShape := oSpirals;
  639.             OTHERWISE
  640.                 Exit(ClickInDoc);
  641.         END;
  642.         WITH oShape DO
  643.             BEGIN
  644.                 fPt.h := vPt.h - fDocRect.left;
  645.                 fPt.v := vPt.v - fDocRect.top;
  646.                 oDialog.DoDialog(2000 + fShapeID);
  647.                 IF oDialog.fDFlag = FALSE THEN
  648.                     Exit(ClickInDoc);
  649.             END;
  650.         self.ReDraw;
  651.         ValidRgn(fViewRgn);
  652.         SetClip(fViewRgn);
  653.         EraseRgn(fViewRgn);
  654.         self.Update;
  655.         ClipRect(thePort^.portRect);
  656.     END; {ClickInDoc}
  657.  
  658. {----------------------------------------}
  659.     PROCEDURE TPictDocument.ReDraw;
  660.         CONST
  661.             PicDwgBeg = 130;
  662.             PicDwgEnd = 131;
  663.             PicGrpBeg = 140;
  664.             PicGrpEnd = 141;
  665.  
  666.         VAR
  667.             vPt: Point;
  668.             vClipRect: Rect;
  669.  
  670.     BEGIN
  671.         IF oShape <> NIL THEN
  672.             BEGIN
  673.                 ForeColor(SetColor(fForeC));
  674.                 BackColor(SetColor(fBackC));
  675.                 WITH oShape DO
  676.                     BEGIN
  677.                         vPt.h := fPt.h + fDocRect.left;
  678.                         vPt.v := fPt.v + fDocRect.top;
  679.                     END;
  680.  
  681.                 SetRect(vClipRect, -10000, -10000, 10000, 10000);
  682.                 ClipRect(vClipRect);
  683.  
  684.                 IF fPictHdl <> NIL THEN
  685.                     KillPicture(fPictHdl);
  686.                 fPictHdl := OpenPicture(fDocRect);
  687.                 PicComment(PicDwgBeg, 0, NIL);
  688.                 PicComment(PicGrpBeg, 0, NIL);
  689.                 oShape.Create(vPt);
  690.                 PicComment(PicGrpEnd, 0, NIL);
  691.                 PicComment(PicDwgEnd, 0, NIL);
  692.                 ClosePicture;
  693.                 fDocRect := fPictHdl^^.picFrame;
  694.                 fChanged := TRUE;
  695.             END;
  696.         IF fPictHdl <> NIL THEN
  697.             InvalRgn(fViewRgn);
  698.     END; {ReDraw}
  699.  
  700. {----------------------------------------}
  701.     PROCEDURE TPictDocument.Update;
  702.     BEGIN
  703.         IF fPictHdl <> NIL THEN
  704.             DrawPicture(fPictHdl, fDocRect);
  705.     END; {Update}
  706.  
  707. {----------------------------------------}
  708.     PROCEDURE TPictDocument.Edit (vItem: Integer);
  709.         VAR
  710.             vScrapHdl: Handle;
  711.             vLength: LongInt;
  712.             vErr: OSErr;
  713.             vOffset: LongInt;
  714.  
  715.     BEGIN
  716.         CASE vItem OF
  717.             kUndo: 
  718.                 ;
  719.             kCut: 
  720.                 BEGIN
  721.                     vScrapHdl := NewHandle(0);
  722.                     vScrapHdl := Handle(fPictHdl);
  723.                     IF vScrapHdl <> NIL THEN
  724.                         IF NOT OSError(ZeroScrap) THEN
  725.                             BEGIN
  726.                                 vLength := GetHandleSize(vScrapHdl);
  727.                                 MoveHHi(vScrapHdl);
  728.                                 HLock(vScrapHdl);
  729.                                 vErr := PutScrap(vLength, 'PICT', vScrapHdl^);
  730.                                 HUnlock(vScrapHdl);
  731.                                 IF oShape <> NIL THEN
  732.                                     oShape := NIL;
  733.                                 IF fPictHdl <> NIL THEN
  734.                                     BEGIN
  735.                                         KillPicture(fPictHdl);
  736.                                         fPictHdl := NIL;
  737.                                     END;
  738.                             END;
  739.                     vScrapHdl := NIL;
  740.                     DisposHandle(vScrapHdl);
  741.                 END;
  742.             kCopy: 
  743.                 BEGIN
  744.                     vScrapHdl := NewHandle(0);
  745.                     vScrapHdl := Handle(fPictHdl);
  746.                     IF NOT OSError(ZeroScrap) THEN
  747.                         IF vScrapHdl <> NIL THEN
  748.                             BEGIN
  749.                                 vLength := GetHandleSize(vScrapHdl);
  750.                                 MoveHHi(vScrapHdl);
  751.                                 HLock(vScrapHdl);
  752.                                 vErr := PutScrap(vLength, 'PICT', vScrapHdl^);
  753.                                 HUnlock(vScrapHdl);
  754.                             END;
  755.                     vScrapHdl := NIL;
  756.                     DisposHandle(vScrapHdl);
  757.                 END;
  758.             kPaste: 
  759.                 BEGIN
  760.                     vScrapHdl := NewHandle(0);
  761.                     vLength := GetScrap(vScrapHdl, 'PICT', vOffset);
  762.                     IF vLength > 0 THEN
  763.                         BEGIN
  764.                             IF fPictHdl <> NIL THEN
  765.                                 BEGIN
  766.                                     KillPicture(fPictHdl);
  767.                                     fPictHdl := NIL;
  768.                                 END;
  769.                             fPictHdl := PicHandle(vScrapHdl);
  770.                             fDocRect := fPictHdl^^.picFrame;
  771.                         END;
  772.                 END;
  773.             kClear: 
  774.                 BEGIN
  775.                     IF oShape <> NIL THEN
  776.                         oShape := NIL;
  777.                     IF fPictHdl <> NIL THEN
  778.                         BEGIN
  779.                             KillPicture(fPictHdl);
  780.                             fPictHdl := NIL;
  781.                         END;
  782.                 END;
  783.             OTHERWISE
  784.         END;
  785.         IF vItem <> kCopy THEN
  786.             BEGIN
  787.                 SetClip(fViewRgn);
  788.                 EraseRgn(fViewRgn);
  789.                 self.Update;
  790.                 ClipRect(thePort^.portRect);
  791.                 fChanged := TRUE;
  792.             END;
  793.     END; {Edit}
  794.  
  795. {----------------------------------------}
  796.     PROCEDURE TPictDocument.Free;
  797.     BEGIN
  798.         IF oOvals <> NIL THEN
  799.             oOvals.Free;
  800.         IF oSpirals <> NIL THEN
  801.             oSpirals.Free;
  802.         IF fPictHdl <> NIL THEN
  803.             KillPicture(fPictHdl);
  804.         INHERITED Free;
  805.     END; {Free}
  806.  
  807. END.    {unit MyDocuments}
  808. {***********************************}